home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / PROGRAM / VIS082S.ARJ / FILEXFER.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-17  |  62KB  |  2,095 lines
  1.   {$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }
  2.   unit filexfer;
  3.  
  4.   Interface
  5.  
  6.   uses crt,dos,
  7.   subs3,gentypes,configrt,modem,statret,gensubs,subs1,subs2,windows,
  8.   userret,mainr1,mainr2,overret1,mycomman,init,mainmenu;
  9.  
  10.   Procedure udsection;
  11.  
  12.   Implementation
  13.  
  14. Procedure udsection;
  15.  
  16.   procedure listarchive;forward;
  17.   Procedure download(autoselect:Integer;FILE_Override:Lstr;Point_Override:integer );Forward;
  18.   Procedure add_to_batch(autoselect:Integer;File_Override:lstr; Point_Override:integer);Forward;
  19.   procedure setarea(n:integer;showit:boolean);forward;
  20.  
  21.   type batchrec=record
  22.        filename:sstr;
  23.        path:string[50];
  24.        by:mstr;
  25.        points,mins:integer;
  26.        size:longint;
  27.        wholefilename:lstr;
  28.        area,filenum:integer;
  29.   end;
  30.  
  31.   arprotorec=array[1..30] of protorec;
  32.  
  33.   batchlist=array[1..50] of batchrec;
  34.  
  35.   Var ud:udrec;
  36.     area:arearec;
  37.     curarea:Integer;
  38.     Batchdown:batchlist;
  39.     filesinbatch:Integer;
  40.     BPOS:integer;
  41.     dproto:arprotorec;
  42.     uproto:arprotorec;
  43.     totalupro:integer;
  44.     totaldownpro:integer;
  45.  
  46. type BIREC=record
  47.   CMDSTR:char;
  48.   REFRESH:char;
  49.   REPLACE:char;
  50.   VERIFY:CHAR;
  51.   DELETE:CHAR;
  52.   DELETEABORT:CHAR;
  53.   DIROVERRIDE:char;
  54.   INCLUDEDIRO:char;
  55.   SOURCEPATH:array [1..80] of char;
  56.   Destpath  :array [1..80] of char;
  57.   Description:array [1..80] of char;
  58. end;
  59.  
  60. type bistuff=record
  61.      shit: array [1..298] of char;
  62.      end;
  63.  
  64.  Procedure AutoUploadGrant(Var Ud:Udrec);
  65.  Var Te,Spoo:Integer;
  66.  Begin
  67.    If ConfigSet.AutoUls>0 then
  68.      Begin
  69.        Ud.Points:=(Ud.FileSize Div Configset.AutoULS);
  70.        Ud.NewFile:=False;
  71.        WriteLn(^S'Granting you '^A,((ud.points * configset.uploadfacto) div  100)
  72.                ,^S' file points.');
  73.        Urec.UdPoints:=Urec.UdPoints+ ((ud.points * configset.uploadfacto) div 100);
  74.      End;
  75.  End;
  76.  
  77.  function abletodoanything(ud:Udrec):Boolean;
  78.  Var C:Boolean;
  79.  Begin
  80.  C:=True;
  81.  If ud.newfile and not issysop then
  82.     Begin
  83.       WriteLn(^S'Sorry, that is a [NEW] file and must be validated first!');
  84.       C:=False;
  85.     End;
  86.  If Ud.SpecialFIle and not IsSysop then
  87.     Begin
  88.       WriteLn(^S'Sorry, that is a Special file and you must have permission!');
  89.       C:=False;
  90.     End;
  91.  If not Exist(Ud.Path+Ud.FileName) then
  92.    Begin
  93.      WriteLn(^S'Sorry, that file is [OFFLINE] and requires special permission.');
  94.      C:=False;
  95.    End;
  96.  AbleToDoAnything:=C;
  97. End;
  98.  
  99.  {$I Bimodem.inc}
  100.  
  101.   Procedure listfiles(extended:Boolean);
  102.     Var cnt,max,r1,r2,kn:Integer;
  103.         T:Char;
  104.     Const extendedstr:Array[false..true] Of String[9]=('','');
  105.     Begin
  106.       If nofiles Then exit;
  107.       writehdr(extendedstr[extended]+'File List');
  108.       max:=numuds;
  109.       thereare(max,'file','files');
  110.       parserange(max,r1,r2);
  111.       If r1=0 Then exit;
  112.       Write(^S); if not extended then doheader else doextended;
  113.       kn:=0;
  114.       For cnt:=r1 To r2 Do Begin
  115.         listfile(cnt,extended);
  116.         If break Then exit;
  117.         inc(kn);
  118.         if kn=20 then repeat
  119.         kn:=0;
  120.          writestr(^M^P'['^A'File Listings '^P'- '^S+area.name+^P'] - ['^F'?/Help'^P'] '^A':*');
  121.          if input='' then input:='N';
  122.          T:=UpCase(Input[1]);
  123.          Case T of
  124.            '+':Add_To_Batch(0,'',0);
  125.            'D':DownLoad(0,'',0);
  126.            'V':ListArchive;
  127.            'Q':Exit;
  128.            'N':DoHeader;
  129.            '?':listinghelp;
  130.          End;
  131.          until match(input,'N') or hungupon;
  132.       End
  133.     End;
  134.  
  135.  
  136.   Function getfilenum(t:mstr):Integer;
  137.     Var n,s:Integer;
  138.     Begin
  139.       getfilenum:=0;
  140.       If Length(Input)>1 Then Input:=Copy(Input,2,255) Else
  141.         Repeat
  142.           writestr(^R'File name/number to '+^S+t+^R' [?=List]:');
  143.           If hungupon Or (Length(Input)=0) Then exit;
  144.           If Input='?' Then Begin
  145.             listfiles(False);
  146.             Input:=''
  147.           End
  148.         Until Input<>'';
  149.       Val(Input,n,s);
  150.       If s<>0 Then Begin
  151.         n:=searchforfile(Input);
  152.         If n=0 Then Begin
  153.           WriteLn(^S'File not found.');
  154.           exit
  155.         End
  156.       End;
  157.       If (n<1) Or (n>numuds)
  158.       Then WriteLn(^P'File number out of range!')
  159.       Else getfilenum:=n
  160.     End;
  161.  
  162.   Procedure addfile(ud:udrec);
  163.     Begin
  164.       seekudfile(numuds+1);
  165.       Write(udfile,ud)
  166.     End;
  167.  
  168.   Procedure getfsize(Var ud:udrec);
  169.     Var df:File Of Byte;
  170.     Begin
  171.       ud.filesize:=-1;
  172.       Assign(df,getfname(ud.path,ud.filename));
  173.       Reset(df);
  174.       If IOResult<>0 Then exit;
  175.       ud.filesize:=FileSize(df);
  176.       Close(df)
  177.     End;
  178.  
  179.   Function wildcardmatch(w,f:sstr):Boolean;
  180.     Var a,b:sstr;
  181.  
  182.     Procedure transform(t:sstr;Var q:sstr);
  183.       Var p:Integer;
  184.  
  185.       Procedure filluntil(k:Char;n:Integer);
  186.         Begin
  187.           While Length(q)<n Do q:=q+k
  188.         End;
  189.  
  190.       Procedure dopart(mx:Integer);
  191.         Var k:Char;
  192.         Begin
  193.           Repeat
  194.             If p>Length(t)
  195.             Then k:='.'
  196.             Else k:=t[p];
  197.             inc(p);
  198.             Case k Of
  199.               '.' :Begin
  200.                      filluntil(' ',mx);
  201.                      exit
  202.                    End;
  203.               '*' :filluntil('?',mx);
  204.             Else If Length(q)<mx Then q:=q+k
  205.             End
  206.           Until 0=1
  207.         End;
  208.  
  209.       Begin
  210.         p:=1;
  211.         q:='';
  212.         dopart(8);
  213.         dopart(11)
  214.       End;
  215.  
  216.     Function theymatch:Boolean;
  217.       Var cnt:Integer;
  218.       Begin
  219.         theymatch:=False;
  220.         For cnt:=1 To 11 Do
  221.           If (a[cnt]<>'?') And (b[cnt]<>'?') And
  222.           (UpCase(a[cnt])<>UpCase(b[cnt])) Then exit;
  223.         theymatch:=True
  224.       End;
  225.  
  226.     Begin
  227.       transform(w,a);
  228.       transform(f,b);
  229.       wildcardmatch:=theymatch
  230.     End;
  231.  
  232.   Const beenaborted:Boolean=False;
  233.  
  234.   Function aborted:Boolean;
  235.     Begin
  236.       If beenaborted Then Begin
  237.         aborted:=True;
  238.         exit
  239.       End;
  240.       aborted:=xpressed Or hungupon;
  241.       If xpressed Then Begin
  242.         beenaborted:=True;
  243.         WriteLn(^B'Newscan abort')
  244.       End
  245.     End;
  246.  
  247.   {$I filexf2.inc}
  248.   Procedure newscan;
  249.     Var cnt:Integer;
  250.       u:udrec;
  251.       kn:integer;
  252.       first:Boolean;
  253.       done:Boolean;
  254.       T:Char;
  255.     Begin
  256.       done:=False;
  257.       Repeat
  258.         first:=False;
  259.         beenaborted:=False; kn:=0;
  260.         For cnt:=1 To FileSize(udfile) Do Begin
  261.           If aborted Then exit;
  262.           seekudfile(cnt);
  263.           Read(udfile,u);
  264.           if kn=20 then repeat
  265.           writestr(^M^P'['^A'File Newscanning '^P'- '^S+area.name+^P'] - ['^F'?/Help'^P'] '^A':*');
  266.           if input='' then input:='N';
  267.           kn:=0;
  268.           T:=UpCase(Input[1]);
  269.           Case T of
  270.             '+':Add_To_Batch(0,'',0);
  271.             'D':Download(0,'',0);
  272.             'V':ListArchive;
  273.             'Q':Begin
  274.                  BeenAborted:=True;
  275.                  Done:=True;
  276.                  WriteLn(^M'Newscan Aborted!');
  277.                  setarea(1,true);
  278.                  exit;
  279.                end;
  280.             'N':DoHeader;
  281.             '?':newscanhelp;
  282.           End;
  283.           until match(input,'N') or hungupon;
  284.           If (u.whenrated>laston) Or (u.when>laston)
  285.           Then Begin
  286.             inc(kn);
  287.             If Not first Then Begin
  288.               doheader;
  289.             first:=True;End;
  290.             listfile(cnt,False);
  291.           End;
  292.         End;
  293.         If first Then Begin
  294.           writestr(^M^P'['^A'File Newscanning '^P'- '^S+area.name+^P'] - ['^F'?/Help'^P'] '^A':*');
  295.           If Input='' Then Input:='N';
  296.           t:=UpCase(Input[1]);
  297.            Case T of
  298.              'A':Done:=False;
  299.              '+':Add_To_Batch(0,'',0);
  300.              'D':download(0,'',0);
  301.              'Q':begin
  302.                  beenaborteD:=true;
  303.                  done:=true;
  304.                end;
  305.             'V':listarchive;
  306.             '?':newscanhelp;
  307.           End;
  308.           if pos(T,'A+DQV?')=0 then done:=True;
  309.         End;
  310.         If Not first Then done:=True;
  311.       Until done;
  312.     End;
  313.  
  314.  
  315.  
  316.     Procedure removefile(n:Integer; gock:boolean);
  317.         Var cnt,un:Integer;
  318.                 u:userrec;
  319.  
  320.         procedure AskDeleteQuery;
  321.         Begin
  322.             WriteStr(^M^P'Remove from '+Ud.SentBy+'s Status? *');
  323.             If Not Yes then Exit;
  324.             Un:=LookUpUser(Ud.SentBy);
  325.             If Un=-1 then WriteLn(^M'User Disappeared!');
  326.             If Un=-1 then Exit;
  327.             Seek(Ufile,Un);
  328.             Read(Ufile,U);
  329.             U.Uploads:=U.Uploads-1;
  330.             U.UdPoints:=U.UdPoints-(Ud.Points*ConfigSet.UploadFacto);
  331.             U.UpKay:=U.UpKay-(Ud.FileSize Div 1024);
  332.             Seek(Ufile,Un);
  333.             Write(Ufile,U);
  334.         End;
  335.  
  336.         Begin
  337.             seekudfile(n);
  338.             read(udfile,ud);
  339.             if gock then askdeletequery;
  340.             For cnt:=n To numuds-1 Do Begin
  341.                 seekudfile(cnt+1);
  342.                 Read(udfile,ud);
  343.                 seekudfile(cnt);
  344.                 Write(udfile,ud)
  345.             End;
  346.             seekudfile(numuds);
  347.             Truncate(udfile)
  348.         End;
  349.  
  350.   Procedure displayfile(Var ffinfo:searchrec);
  351.     Var a:Integer;
  352.     Begin
  353.       a:=ffinfo.attr;
  354.       If (a And 8)=8 Then exit;
  355.       tab(ffinfo.name,13);
  356.       If (a And 16)=16
  357.       Then Write('Directory')
  358.       Else Write(ffinfo.size);
  359.       If (a And 1)=1 Then Write(' [read-only]');
  360.       If (a And 2)=2 Then Write(' [hidden]');
  361.       If (a And 4)=4 Then Write(' [system]');
  362.       WriteLn
  363.     End;
  364.  
  365.   Function defaultdrive:Byte;
  366.     Var r:registers;
  367.     Begin
  368.       r.ah:=$19;
  369.       Intr($21,r);
  370.       defaultdrive:=r.al+1
  371.     End;
  372.  
  373.   Procedure directory;
  374.     Var r:registers;
  375.       ffinfo:searchrec;
  376.       tpath:anystr;
  377.       b:Byte;
  378.       cnt:Integer;
  379.     Begin
  380.       tpath:=area.xmodemdir;
  381.       If tpath[Length(tpath)]<>'\' Then tpath:=tpath+'\';
  382.       tpath:=tpath+'*.*';
  383.       writestr('Path/wildcard [CR for '+^S+tpath+^P+']:');
  384.       WriteLn(^M);
  385.       If Length(Input)<>0 Then tpath:=Input;
  386.       writelog(16,10,tpath);
  387.       findfirst(Chr(defaultdrive+64)+':\*.*',8,ffinfo);
  388.       If doserror<>0
  389.       Then WriteLn('No volume label'^M)
  390.       Else WriteLn('Volume label: ',ffinfo.name,^M);
  391.       findfirst(tpath,$17,ffinfo);
  392.       If doserror<>0 Then WriteLn('No files found.') Else Begin
  393.         cnt:=0;
  394.         While doserror=0 Do Begin
  395.           inc(cnt);
  396.           If Not break Then displayfile(ffinfo);
  397.           findnext(ffinfo)
  398.         End;
  399.         WriteLn(^B^M'Total files: ',cnt)
  400.       End;
  401.       Write('Free disk space: ');
  402.       writefreespace(tpath)
  403.     End;
  404.  
  405.     Function OKRatiosAnd(Ud:Udrec):Boolean;
  406.     Var C:Boolean;
  407.       Procedure SeaError(M:Lstr);
  408.       Begin
  409.         C:=False;
  410.         WriteLn(^S,M);
  411.       End;
  412.  
  413.     Begin
  414.     C:=True;
  415.       If Not Area.DownLoadHere then
  416.           SeaError('You may not download in this area!');
  417.       If Not OkUdRatio and C then seaerror('Your Upload/Download Ratio is out of wack! Upload First!');
  418.       If Not OkUdK and C then
  419.             SeaError('Your Upload/Download K Ratio is out of wack! Upload First!');
  420.       If (Ud.SendTo<>'') and Not Match(Ud.Sendto,Urec.Handle) and C then
  421.             SeaError('This file is Not for you!');
  422.       If (Ud.Pass<>'') and C then
  423.          Begin
  424.            WriteStr(^M^S'Password Protected file!'^M^M^P'Password:');
  425.            If not Match(Input,Ud.Pass) then
  426.              SeaError('Wrong Password');
  427.            End;
  428.       OkRatiosAnd:=C;
  429.     End;
  430.  
  431.  
  432.  
  433.     Procedure download(autoselect:Integer;FILE_Override:Lstr;Point_Override:integer );
  434.  
  435.     Var totaltime:sstr;
  436.       timewhilebeing:integer;
  437.       fsize:longint;
  438.       proto,num,mins:Integer;
  439.       ud:udrec;
  440.       shit:integer;
  441.       joe:longint;
  442.       zmodem,fname:lstr;
  443.       ymodem:Boolean;
  444.       b:Integer;
  445.       f:File;
  446.     Begin
  447. if file_override='' then begin
  448.       If Not allowxfer Then exit;
  449.       If nofiles Then exit;
  450.       If autoselect=0
  451.       Then num:=getfilenum('download')
  452.       Else num:=autoselect;
  453.       If num=0 Then exit;
  454.       WriteLn;
  455.       seekudfile(num);
  456.       Read(udfile,ud);
  457.       if file_OverRide='' then if Not OkRatiosAnd(Ud) then Exit;
  458.       end else ud.points:=point_override;
  459.       If (Not sponsoron) And (ud.points>urec.udpoints) and (not configset.leechwee)
  460.       Then Begin
  461.         WriteLn(^P'That file requires '^S,ud.points,^P' points.');
  462.         exit
  463.       End;
  464.       If (File_override='') and Not AbleToDoAnything(Ud) then Exit;
  465.       if file_override='' then fname:=getfname(ud.path,ud.filename) else
  466.           fname:=file_override;
  467.       If tempsysop Then Begin
  468.         ulvl:=regularlevel;
  469.         tempsysop:=False;
  470.         writeurec;
  471.         bottomline
  472.       End;
  473.       ymodem:=False;
  474.       proto:=protocaseselection(true);
  475.       if proto=0 then exit;
  476.       Assign(f,fname);
  477.       Reset(f);
  478.       iocode:=IOResult;
  479.       If iocode<>0 Then
  480.         Begin
  481.           fileerror('DOWNLOAD',fname);
  482.           exit
  483.         End;
  484.       fsize:=FileSize(f);
  485.       Close(f);
  486.       totaltime:=minstr(fsize);
  487.       mins:=valu(Copy(totaltime,1,Pos(':',totaltime)-1));
  488.       If ((mins>timeleft) And (Not sponsoron)) Then Begin
  489.         writestr(^S'Insufficient time for transfer!');
  490.         exit
  491.       End;
  492.       If (mins-5>timetillevent) Then Begin
  493.         writestr(^S'You may not transfer right before the event occurs.');
  494.         exit
  495.       End;
  496.       If (vt52 in urec.config) or (ansigraphics In urec.config) Then Begin
  497.       clearscr;
  498.       printxy(4,1,'');End;
  499.       bottomline;
  500.       Writehdr('File Download');
  501.       if file_override='' then begin
  502.       WriteLn(^R'Filename:         '^S,upstring(ud.filename));
  503.       WriteLn(^R'Uploaded by:      '^S,ud.sentby);
  504.       WriteLn(^R'Times downloaded: '^S,ud.downloaded);
  505.       If ymodem Then fsize:=(fsize+7) Div 8;
  506.       Write(^R'Cost (pts.):      '^S);
  507.       if (ud.points>0) and (not configset.leechwee) then writeln(ud.points) else
  508.       writeln('Free');
  509.       joe:=fsize*128;
  510.       WriteLn(^R'Bytes to send :   '^S,strlong(joe));
  511.       WriteLn(^R'Approx. Time :    '^S,totaltime);
  512.       WriteLn(^R'Current Time Left:'^S,timeleft);
  513.       end;
  514.       WriteLn(^M^M^S'Press ['^A'Ctrl-X'^S'] many times to abort'^B);
  515.       Delay(2500);   clrscr;
  516.       timewhilebeing:=timeleft;
  517.       b:=protocolxfer(True,False,ymodem,proto,fname);
  518.       beepbeep(b);
  519.       If (b=0) Or (b=1) Then Begin
  520.         writelog(15,1,fname);
  521.         inc(urec.downloads);
  522.         if file_override='' then begin
  523.         inc(ud.downloaded);
  524.         seekudfile(num);
  525.         Write(udfile,ud);
  526.         end;
  527.         delay(2000);
  528.         if file_override='' then
  529.         pointcom(ud.sentby,ud.points);
  530.         nosound;
  531.   if file_override='' then else      ud.points:=Point_override;
  532.         If (ud.points>0) and (not configset.leechwee) Then Begin
  533.           WriteLn(^M^M^R'Your File Points --> '^S,urec.udpoints);
  534.           WriteLn(^R'File Xfer Charge --> '^S,ud.points);
  535.           WriteLn(^B^P'                     -----');
  536. if sponsoron then
  537.           Writeln(^B^S'No Charge for Sysop>');
  538.        if not sponsoron then urec.udpoints:=urec.udpoints-ud.points;
  539.           WriteLn(^R'Your new total ----> '^S,urec.udpoints);
  540.         End;
  541.         writeurec;
  542.       End
  543.     End;
  544.  
  545.   Procedure upload;
  546.     Var ud:udrec;
  547.       ok,crcmode,ymodem:Boolean;
  548.       proto,b:Integer;
  549.       zmodem,fn:lstr;
  550.       start_time : integer ;
  551.       tmp1,tmp2:anystr;
  552.       _name:namestr;
  553.       _ext:extstr;
  554.  
  555.     Begin
  556.           if area.uploadhere<>true then writeln (^S'You can not upload to this area!');
  557.       if area.uploadhere<>true then exit;
  558.       If Not allowxfer Then exit;
  559.       If (timetillevent<30) Then Begin
  560.         writestr(
  561.         'Uploads are not allowed within 30 minutes of Events!');
  562.         exit
  563.       End;
  564.       ok:=False;
  565.       boxfile;
  566.       If ansigraphics in urec.config then Goxy(26,2); writefreespace(area.xmodemdir);
  567.       if not enoughfree(area.xmodemdir) then exit;
  568.       WriteLn;
  569.       Repeat
  570.         If ansigraphics in urec.config then Goxy(6,4);
  571.         writestr(^S'File Name          :');
  572.         If Length(Input)=0 Then exit;
  573.         If Not validfname(Input) Then Begin
  574.           Printxy(4,26,^S'Invalid filename!'^M^M^M^M^M^M);
  575.           exit
  576.         End;
  577.         ud.filename:=upstring(Input);
  578.         ud.path:=area.xmodemdir;
  579.         fn:=getfname(ud.path,ud.filename);
  580.         If hungupon Then exit;
  581.         If exist(fn)
  582.         Then Printxy(4,26,^S'Filename already exists!'^M^M^M^M)
  583.         Else ok:=True
  584.       Until ok;
  585.       ymodem:=False;
  586.       If ansigraphics in urec.config then Goxy(27,5) Else Write('Password :');
  587.       buflen:=20;
  588.       WriteStr('*');
  589.       If input>'' then ud.pass:=input;
  590.       If ansigraphics in urec.config then begin
  591.       Goxy(13,6);
  592.       WriteStr('*');
  593.       end;
  594.       If ansigraphics in urec.config then Goxy(8,8) Else Write('Description:');
  595.       BufLen:=40;
  596.       writestr('*');
  597.       ud.descrip:=Input;
  598.       If ansigraphics in urec.config then Goxy(29,9) Else Write('Private For:');
  599.       WriteStr('*');
  600.       if input>'' then ud.sendto:=input;
  601.       proto:=protocaseselection(false);
  602.       if proto=0 then exit;
  603.       clearscr;
  604.       bottomline;
  605.       Writehdr(Ud.filename+' Upload');
  606.       WriteLn(^S'Receive ready.'^R' Press [Ctrl-X] many times to Abort!');
  607.       If tempsysop Then Begin
  608.         ulvl:=regularlevel;
  609.         tempsysop:=False;
  610.         writeurec;
  611.         bottomline
  612.       End;
  613.       start_time := timeleft ;clrscr;
  614.       delay(2500);
  615.       b:=protocolxfer(False,crcmode,ymodem,proto,fn);
  616.       beepbeep(b);
  617.       If b=0 Then Begin
  618.         writelog(15,2,ud.filename);
  619.         ud.sentby:=unam;
  620.         ud.when:=now;
  621.         ud.whenrated:=now;
  622.         ud.points:=0;
  623.         ud.sendto:='';
  624.         ud.downloaded:=0;
  625.         ud.newfile:=True;
  626.         ud.specialfile:=False;
  627.         ud.downloaded:=0;
  628.         ud.pass:='';
  629.         ud.path:=area.xmodemdir;
  630.         tmp1:=ud.path;
  631.         tmp2:=ud.filename;
  632.         addzipcomment(tmp1+tmp2,tmp1,tmp2);
  633.           WriteLn('Thanks for the upload');
  634.         getfsize(ud);
  635.         AutoUploadGrant(Ud);
  636.         addfile(ud);
  637.         inc(urec.uploads);
  638.         inc(newuploads);
  639.         inc(gnuf);
  640.         settimeleft(start_time+(((start_time-timeleft)*configset.timepercentbac) div 100));
  641.       End;
  642.     End;
  643.  
  644.   Procedure clear_batchdown;
  645.         Begin
  646.             filesinbatch:=0;
  647.             fillchar(BatchDown,SizeOf(BatchDown),0);
  648.         End;
  649.  
  650.   Function batchtotaltime:longint;
  651.     Var cnt:Integer;
  652.       Time:Integer;
  653.     Begin
  654.       time:=0;
  655.       If filesinbatch>0 Then Begin
  656.         For cnt:=1 To filesinbatch Do Begin
  657.           time:=time+batchdown[cnt].mins;
  658.         End;
  659.         batchtotaltime:=time;
  660.       End Else batchtotaltime:=0;
  661.     End;
  662.  
  663.   Function totalpoints:longint;
  664.     Var cnt:Integer;
  665.       points:Integer;
  666.     Begin
  667.       points:=0;
  668.       If filesinbatch>0 Then Begin
  669.         For cnt:=1 To filesinbatch Do Begin
  670.           points:=points+batchdown[cnt].points;
  671.         End;
  672.         totalpoints:=points;
  673.       End Else totalpoints:=0;
  674.     End;
  675.  
  676.   Procedure listbatch;
  677.     Var cnt,a,b:Integer;
  678.       Z:sstr;
  679.       totk,tempk:longint;
  680.       Justy:Integer;
  681.     Begin
  682.       If filesinbatch<1 Then WriteLn(^S'No files in batch!'^G);
  683.       If filesinbatch<1 Then exit;
  684.       clearscr;
  685.       totk:=0;
  686.       Writehdr('Batch Xfer List');
  687.       writeln (^P'╒════════════════════════════════════════════════════════════════════╕');
  688.       writeln (^P'│ '^S'File Name'^P'                        '^S'Bytes'^P'    '^S'  Points'^P'     '^S' Minutes'^P'    │');
  689.       writeln (^P'╞════════════════════════════════════════════════════════════════════╡');
  690.         For cnt:=1 To FilesInBatch Do begin
  691.           Write (^P'│  '^A);
  692.           Tab(Upstring(BatchDown[Cnt].FileName),30);
  693.           Write (^P'  '^F);
  694.           TempK:=BatchDown[Cnt].Size Div 1024;
  695.           TotK:=TotK+TempK;
  696.           Tab(StrLong(BatchDown[Cnt].Size),8);
  697.           Write (^P'  '^U);
  698.           Tab(Strr(BatchDown[Cnt].Points),11);
  699.           Write (^P'  '^P);
  700.           Tab(Strr(BatchDown[Cnt].Mins),11);
  701.           writeln (^P'│');
  702.           if Break then Exit;
  703.           End;
  704.       writeln (^P'╘════════════════════════════════════════════════════════════════════╛');
  705.       justy:=totalpoints;
  706.       WriteLn(^M^R'Accumulated File points ---> '^S,justy);
  707.       Justy:=batchtotaltime;
  708.       WriteLn(^R'Accumulated Mins for Xfer -> '^S,justy);
  709.       writeln(^R'Total K-Bytes in file Xfer > '^S,totk);
  710.      End;
  711.  
  712.     Procedure add_to_batch(autoselect:Integer;File_Override:lstr; Point_Override:integer);
  713.     Var totaltime:sstr;
  714.       proto,num,fsize,mins:Integer;
  715.       ud:udrec;
  716.       zmodem,fname:lstr;
  717.       tempo:longint;
  718.       ymodem:Boolean;
  719.       Too,Too1:mstr;
  720.       b:Integer;
  721.       f:file;
  722.       fn:File of byte;
  723.     Begin
  724.     if filesinbatch>=50 then writeln ('You can only have 50 files tagged!');
  725.     if filesinbatch>=50 then exit;
  726.     if file_override='' then begin
  727.       If nofiles Then exit;
  728.       If autoselect=0
  729.       Then num:=getfilenum('add to batch')
  730.       Else num:=autoselect;
  731.       If num=0 Then exit;
  732.       WriteLn;
  733.       seekudfile(num);
  734.       Read(udfile,ud);
  735.       if not OkRatiosAnd(Ud) then Exit;
  736.       end else ud.points:=point_override;
  737.       if not allowbaud then exit;
  738.       If (Not sponsoron) And (((Totalpoints)+(ud.points))>urec.udpoints) and (not configset.leechwee)
  739.        Then Begin
  740.         WriteLn(^S'You do not have sufficient points to add this file!');
  741.         exit
  742.       End;
  743.       If (File_override='') and not AbleToDoAnything(Ud) then Exit;
  744.       If tempsysop Then Begin
  745.         ulvl:=regularlevel;
  746.         tempsysop:=False;
  747.         writeurec;
  748.         bottomline
  749.       End;
  750. if file_override='' then   fname:=getfname(ud.path,ud.filename) else
  751.                            fname:=file_override;
  752.       Assign(f,fname);
  753.       Reset(f);
  754.       iocode:=IOResult;
  755.       If iocode<>0 Then
  756.         Begin
  757.           fileerror('DOWNLOAD',fname);
  758.           exit
  759.         End;
  760.       fsize:=FileSize(f);
  761.       Close(f);    assign(fn,fname); reset(fn);tempo:=filesize(fn);close(fn);
  762.       totaltime:=minstr(fsize);
  763.       mins:=valu(Copy(totaltime,1,Pos(':',totaltime)-1));
  764.       If (((mins+batchtotaltime)>timeleft) And (Not sponsoron)) Then Begin
  765.         writestr(^S'Insufficient time to add this file to batch!');
  766.         exit
  767.       End;
  768.       If (mins-5>timetillevent) Then Begin
  769.         writestr(^S'Sorry, the event is happening in a few minutes.');
  770.         exit
  771.       End;
  772.       b:=filesinbatch;
  773.       inc(b);filesinbatch:=b;
  774.       batchdown[b].size:=tempo;
  775.       if file_override<>'' then ud.sentby:='';
  776.       batchdown[b].by:=ud.sentby;
  777.       batchdown[b].wholefilename:=fname;
  778.       batchdown[b].mins:=mins;
  779.       batchdown[b].area:=curarea;
  780.       batchdown[b].filenum:=num;
  781.       if not configset.leechwee then batchdown[b].points:=ud.points else
  782.       batchdown[b].points:=0;
  783.       fsplit (fname,ud.path,too,too1);
  784.       ud.filename:=too+too1;
  785.       batchdown[b].filename:=ud.filename;
  786.       batchdown[b].path:=ud.path;
  787.       Appendbimodem ('U',fname,' ');
  788.       WriteLn(^B^P,upstring(ud.filename),' added to batch que');
  789.     End;
  790.  
  791.       Procedure BIMODEMupload;
  792.     Var ud:udrec;
  793.       ok,crcmode,ymodem:Boolean;
  794.       proto,b:Integer;
  795.       YF,zmodem,fn:lstr;
  796.       start_time : integer ;
  797.     Begin
  798.  
  799.       ok:=False;
  800.      writehdr ('ADD BIMODEM UPLOAD');
  801.       WriteLn;
  802.       writeln ('You Must specify the file your going to upload');
  803.       writeln ('including the drive/direct on Your computer.');
  804.       writeln ('Then specify the filename <no dirs> you want the bbs to name it.'^M);
  805.       Repeat
  806.         writestr('Full Filename on YOUR computer:');
  807.         If Length(Input)=0 Then exit;
  808.          yf:=input;
  809.         Writestr('Filename for the bbs:');
  810.         if length(input)=0 then exit;
  811.         If Not validfname(Input) Then Begin
  812.           WriteLn(^S'Invalid filename!');
  813.           exit
  814.         End;
  815.         ud.filename:=upstring(Input);
  816.         ud.path:=area.xmodemdir;
  817.         fn:=getfname(ud.path,ud.filename);
  818.         If hungupon Then exit;
  819.         If exist(fn)
  820.         Then WriteLn(^S'Filename already exists! Try Again!')
  821.         Else ok:=True
  822.       Until ok;
  823.  
  824.       APPENDBIMODEM ('D',yf,fn);
  825.       Writeln (^S'File added!');
  826.     end;
  827.  
  828.   Procedure Do_batch_download;
  829.     Var zmodem:Char;
  830.       proto:Integer;
  831.       laterguy:boolean;
  832.       b:Integer;
  833.  
  834.     Begin
  835.     if filesinbatch<1 then exit;
  836.       If (vt52 in urec.config) or (ansigraphics In urec.config) Then clearscr;
  837.       Writehdr('ViSiON Batch Protocols');
  838.       WriteLn(^P'['^R'Y'^P']modem-Batch        ['^R'Z'^P']modem ''90');
  839.       WriteLn(^P'['^R'G'^P'] Ymodem-G          ['^R'P'^P']cp Zmodem   ');
  840.       WRiteln(^P'['^R'S'^P'] Puma              ['^R'4'^P']k Zmodem [pB4096 rz]');
  841.       writestr(^M'Select a Protocol ['+^V+'Z'+^P'] : *');
  842.       If Input='' Then Input:='Z';
  843.       zmodem:=UpCase(Input[1]);
  844.       Proto:=Pos(Zmodem,'YZGPS4');
  845.       if proto=0 then exit;
  846.       writestr(^M^P'Do you wish to hang up after your download is completed? *');
  847.       laterguy:=yes;
  848.       listbatch;
  849.       WriteLn(^M^S'+-Sending Batch Que Now!-+');
  850.       delay(500);
  851.       b:=0;
  852.       B:=Batch_Download(Proto,filesinbatch,Batchdown);
  853.       If b>0 Then Begin
  854.          If (b>0)  Then Begin
  855.           WriteLn(^M^M^P'Your File Points --> '^S,urec.udpoints);
  856.           WriteLn(^P'Batch Xfer Total --> '^S,b);
  857.           WriteLn(^B^P'                     -----');
  858.           urec.udpoints:=urec.udpoints-b;
  859.           WriteLn(^B'Your new total ----> '^s,urec.udpoints);
  860.         End;
  861.         writeurec;
  862.       End;
  863.        clear_batchdown;
  864.       if laterguy then begin
  865.          writeln(^M^R'(* '^P'Performing Auto-Disconnect '^R' *)');
  866.          delay(2500);
  867.          writeurec;
  868.          hangup;
  869.          disconnect;
  870.       end;
  871.     End;
  872.  
  873. procedure DOBIXFER;
  874.     var a:text;
  875.     Such:integer;
  876.     b:anystr;
  877.     BIdir,BBsdir:lstr;
  878.  
  879. Procedure process_uploads;
  880.  
  881. var BISEX:file of birec;
  882.     HOMO,FAG:birec;
  883.     krad,cnt:integer;
  884.     zmodem:lstr;
  885.     ud:udrec;
  886.     _name:namestr;
  887.     kenny1:anystr;
  888.     kenny2:anystr;
  889.     _ext:extstr;
  890.  
  891. begin
  892. if not exist('vision.pth') then begin Writeln (configset.bimodemdi+'vision.pth is missing!');exit;
  893.  
  894.                              end;
  895. writehdr ('Checking your uploads');
  896. assign (bisex,'vision.pth');
  897. reset(bisex);
  898.  
  899. for cnt:=1 to filesize(bisex) do begin
  900. seek (bisex,cnt-1);
  901. read(bisex,homo);
  902.  
  903. if ( (homo.cmdstr='R') or (homo.cmdstr='D') ) and (exist(homo.destpath)) then begin
  904.         Zmodem:=homo.destpath;
  905.         getpathname(Zmodem,ud.path,ud.filename);
  906.         If Not hungupon Then Begin
  907.           BufLen:=40;
  908.           input:=ud.filename;
  909.           ud.filename:=upstring(input);
  910.           Writestr(^B^P'Description for '^S+Ud.filename+^P' :');
  911.           ud.descrip:=Input;
  912.         End Else ud.descrip:='';
  913.         kenny1:=ud.path;kenny2:=ud.filename;
  914.         addzipcomment(kenny1+kenny2,kenny1,kenny2);
  915.         writelog(15,2,ud.filename);
  916.         ud.sentby:=unam;
  917.         ud.when:=now;
  918.         ud.whenrated:=now;
  919.         ud.points:=0;
  920.         ud.downloaded:=0;
  921.         ud.newfile:=True;
  922.         ud.specialfile:=False;
  923.         ud.downloaded:=0;
  924.         ud.sendto:='';
  925.         ud.pass:='';
  926.         getfsize(ud);
  927.         addfile(ud);
  928.         Inc(urec.uploads);
  929.         inc(newuploads);
  930.         inc(gnuf);
  931.       End;
  932.  
  933.  
  934. end;
  935. close(bisex);
  936. end;
  937.  
  938.     begin
  939.     Writehdr('Executing BiModem');
  940.     assign (a,'bimodem.log');
  941.     if exist('bimodem.log') then erase(A);
  942.     bidir:=configset.bimodemdi;
  943.     bidir[(length(bidir))]:=' ';
  944.     chdir (bidir);
  945.     Writeln (Usr,'* Changing to Bimodem dir: ',configset.bimodemdi);
  946.     exec ('bimodem.com','');
  947.     BBSDIR:=configset.forumdi;
  948.     bbsdir [(length(bbsdir))]:=' ';
  949.     chdir (bbsdir);
  950.     delay(2000);
  951.     Writestr ('Press [Return] to Continue :');
  952.     if filesinbatch>0 then begin
  953.       such:=BIcharge(filesinbatch,Batchdown);
  954.       If such>0 Then Begin
  955.        inc(urec.downloads);
  956.         If (such>0) And (Not sponsoron) Then Begin
  957.           WriteLn(^M^P'Your File Points --> '^S,urec.udpoints);
  958.           WriteLn(^P'Batch Xfer Total --> '^S,such);
  959.           WriteLn(^B^P'                     -----');
  960.           urec.udpoints:=urec.udpoints-such;
  961.           WriteLn(^B'Your new total ----> '^s,urec.udpoints);
  962.         End;
  963.         writeurec;
  964.  
  965.       end;
  966.     end;
  967.     Process_Uploads;
  968.     killbimodem;clear_batchdown;
  969.     Writeln (^b'Thank you for using Bimodem!');
  970.     end;
  971.  
  972.   Procedure Batch_upload;
  973.     Var ud:udrec;
  974.     kenny1,kenny2:anystr;
  975.     _name:namestr;
  976.     _ext:extstr;
  977.       ok,crcmode,ymodem:Boolean;
  978.       cnt,proto,b:Integer;
  979.       zmodem,fn:lstr;
  980.       BITCH:batchlist;
  981.       te:integer;
  982.       start_time : integer ;
  983.     Begin
  984.       If (timetillevent<30) Then Begin
  985.         writestr('Uploads are not allowed within 30 minutes of Timed Event!');
  986.         exit
  987.       End;
  988.       ok:=False;
  989.       Write(^P'Free Space: ');
  990.       writefreespace(area.xmodemdir);
  991.       if not enoughfree(area.xmodemdir) then exit;
  992.       ymodem:=False;
  993.       WriteLn(^M^M);
  994.       writehdr('Batch Protocols');
  995.       WriteLn(^P'['^R'Y'^P']modem (True)       ['^R'Z'^P']modem');
  996.       WriteLn(^P'['^R'G'^P'] Ymodem-G          ['^R'P'^P']cp Zmodem');
  997.       Writeln(^P'['^R'S'^P'] Puma              ['^R'Q'^P']uit'^M);
  998.       writestr(^B'Select a Protocol ['+^V+'Z'+^W']: *');
  999.       If Input = '' Then Input := 'Z' ;
  1000.       zmodem:=UpCase(Input[1]);
  1001.       Proto:=Pos(Zmodem,'YZGPS');
  1002.       if proto=0 then exit;
  1003.       WriteLn(^S'Batch Receive ready. Press [Ctrl-X] many times to Abort!');
  1004.       If tempsysop Then Begin
  1005.         ulvl:=regularlevel;
  1006.         tempsysop:=False;
  1007.         writeurec;
  1008.         bottomline
  1009.       End;
  1010.       clear_batchdown;
  1011.       cnt:=0;
  1012.       start_time := timeleft ;
  1013.       B:=BatchUpload(Proto);
  1014.       delay(2000);
  1015.       Writestr(^P'Press '^R'[Return]'^P' to continue:');
  1016.       WriteLn(^B^M'Total Files received -> ',filesinbatch);
  1017.       If filesinbatch=0 Then exit;
  1018.       For cnt:=1 To filesinbatch Do Begin
  1019.         Zmodem:=batchdown[cnt].wholefilename;
  1020.         getpathname(Zmodem,ud.path,ud.filename);
  1021.         If Not hungupon Then Begin
  1022.           BufLen:=38;
  1023.           input:=ud.filename;
  1024.           ud.filename:=upstring(input); nochain:=true;
  1025.           Writestr(^B'Description for '^S+Ud.filename+^P' :');
  1026.           ud.descrip:=Input;
  1027.         End Else ud.descrip:='';
  1028.         kenny1:=ud.path;
  1029.         kenny2:=ud.filename;
  1030.         addzipcomment(kenny1+kenny2,kenny1,kenny2);
  1031.         writelog(15,2,ud.filename);
  1032.         ud.sentby:=unam;
  1033.         ud.when:=now;
  1034.         ud.whenrated:=now;
  1035.         ud.sendto:='';
  1036.         ud.points:=0;
  1037.         ud.downloaded:=0;
  1038.         ud.newfile:=True;
  1039.         ud.specialfile:=False;
  1040.         ud.downloaded:=0;
  1041.         ud.pass:='';
  1042.         getfsize(ud);
  1043.         AutoUploadGrant(Ud);
  1044.         addfile(ud);
  1045.         Inc(urec.uploads);
  1046.         inc(newuploads);
  1047.         inc(gnuf);
  1048.       End;
  1049.         clear_batchdown;
  1050.       WriteLn(^B^M'Thank you for Batch Uploading!');
  1051.      settimeleft(start_time+(((Start_time-timeleft)*configset.timepercentbac) div 100))
  1052.     End;
  1053.  
  1054.   Procedure searchfile;
  1055.     Var cnt:Integer;
  1056.     searchall:Boolean;
  1057.     found:boolean;
  1058.     wildcard:sstr;
  1059.     a:arearec;
  1060.  
  1061.     Procedure searcharea;
  1062.       Var cnt:Integer;
  1063.         u:udrec;
  1064.         po:integer;
  1065.         krad1,krad2,krad3,krad4,krad5:anystr;
  1066.  
  1067.       function stringit(l1,l2:anystr):anystr;
  1068.       var l3,l4:anystr;
  1069.           t1,t2:anystr;
  1070.       begin
  1071.        po:=pos(l1,upstring(l2));
  1072.        l3:=l2;
  1073.        if po>0 then begin
  1074.          l3:=copy(l2,0,po-1);
  1075.          l3:=l3+^S+l1+^U;
  1076.          l3:=l3+copy(l2,length(l3)-1,(length(l2)-(length(l3)-2)));
  1077.          end;
  1078.        stringit:=l3;
  1079.        end;
  1080.  
  1081.        procedure listfiles(n:integer;extended:boolean;k1,k2,k3,k4:anystr);
  1082.       var ud:udrec;
  1083.           q:sstr;
  1084.           path,filez:anystr;
  1085.           sze:longint;
  1086.           ofline:boolean;
  1087.       begin
  1088.            seekudfile(n);
  1089.            read(udfile,ud);
  1090.            filez:=getfname(ud.path,ud.filename);
  1091.            ofline:=(exist(filez))=false;
  1092.            write(' ');
  1093.            write(^P);tab(strr(n)+'.',4);
  1094.            write(^U);po:=8;
  1095.            if pos(^S,k2)>0 then po:=10;
  1096.            tab(k2,po);po:=4;if pos(^S,k4)>0 then po:=6;
  1097.            write(upstring(k4):po,'  ');
  1098.            write(^R);
  1099.            if (ud.sendto='') then
  1100.              if ud.newfile then write(' New   ') else if ud.specialfile then
  1101.                                 write(' Ask   ') else if (ud.points>0) and (not configset.leechwee)
  1102.                                 then write(ud.points:4,'   ')
  1103.                                 else write(' Free  ')
  1104.                                 else begin ansicolor(4);
  1105.                                 if match(ud.sendto,urec.handle) then write(' Take  ') else
  1106.                                 write(' Priv  ');end;
  1107.                                 ansicolor(13);
  1108.                                 if not exist(ud.path+ud.filename) then tab('[Offline]',10) else begin
  1109.                                 sze:=ud.filesize;
  1110.                                 if sze<1024 then sze:=1025;
  1111.                                 write(strlong(sze div 1024)+'k':9,' ');
  1112.                                 end;
  1113.                                 write(^U);
  1114.                                 if k3='' then k3:='- No Description Given -';
  1115.                                 po:=39; if pos(^S,k3)>0 then po:=41;
  1116.                                 writeln(' ',copy(k3,1,po));
  1117.                                 end;
  1118.       Begin
  1119.         For cnt:=1 To numuds Do Begin
  1120.           seekudfile(cnt);
  1121.           Read(udfile,u);
  1122.           krad1:=upstring(wildcard);
  1123.           fsplit(U.filename,u.path,krad2,krad4);
  1124.           krad3:=u.descrip;
  1125.           krad2:=stringit(krad1,upstring(krad2));
  1126.           krad3:=stringit(krad1,krad3);
  1127.           krad4:=stringit(krad1,upstring(krad4));
  1128.                     If ((Pos(krad1,krad2)>0) Or (Pos(krad1,krad3)>0)) or ((pos(krad1,krad4)>0))
  1129.                     Then
  1130.                         begin
  1131.                          listfiles(cnt,False,krad1,krad2,krad3,krad4);
  1132.                          found:=true;
  1133.                         end;
  1134.           If xpressed Then exit
  1135.         End
  1136.       End;
  1137.  
  1138.     Begin
  1139.      Writehdr('File Search');
  1140.       writestr('Search all areas [y/N]? *');
  1141.       searchall:=yes;
  1142.       Writeln (^M^S'Do NOT use wildcards!');
  1143.       writestr(^M^P'TEXT to search for :');
  1144.       If Length(Input)=0 Then exit;
  1145.       wildcard:=Input;
  1146.       If Pos('.',WildCard)>0 Then
  1147.         WildCard:=Copy(WildCard,1,Pos('.',WildCard)-1);
  1148.       If Not searchall Then Begin
  1149.         searcharea;
  1150.         exit
  1151.       End;
  1152.       For cnt:=1 To numareas Do Begin
  1153.         seekafile(cnt);
  1154.         Read(afile,a);
  1155.         If allowed_in_Area(a) Then
  1156.           Begin
  1157.                         setarea(cnt,false);
  1158.                         clearscr;
  1159.                         found:=false;
  1160.                         writeln(^R'Searching Area ['^S,curarea:2,^R'] '^S,area.name,^R);
  1161.                         writeln;
  1162.                         searcharea;
  1163.                         if found then writestr(^M^R'Press [Return] to continue:');
  1164.                         If xpressed Then begin
  1165.                             printxy(19,1,'');
  1166.                             exit;
  1167.                             end;
  1168.                     End
  1169.             End
  1170.         End;
  1171.   Procedure newscanall;
  1172.     Var cnt:Integer;
  1173.       a:arearec;
  1174.       start_area : integer ;
  1175.     Begin
  1176.     clearscr;
  1177.       Writehdr(' Newscanning All Areas... ');
  1178.       writeln(^B'Press [X] to Abort.');
  1179.       beenaborted:=False;
  1180.       If aborted Then exit;
  1181.       start_area := curarea ;
  1182.       For cnt:=1 To FileSize(afile) Do Begin
  1183.         seekafile(cnt);
  1184.         Read(afile,a);
  1185.         If Allowed_in_Area(a) Then Begin
  1186.                          If aborted Then begin
  1187.                          printxy(19,1,'');
  1188.                          setarea(start_area,true);
  1189.                          exit;
  1190.                          end ;
  1191.                     setarea(cnt,false);
  1192.                     clearscr;
  1193.                     WriteLn(^S' '^P'NewScanning... '^S' ■ '^P,Area.Name,^S' ■ '^P,curarea,^S' ■');
  1194.                     If aborted Then begin
  1195.                         printxy(19,1,'');
  1196.                          setarea(start_area,true);
  1197.                          exit;
  1198.              end ;
  1199.           newscan   ;
  1200.                                         If aborted Then begin
  1201.                                         printxy(19,1,'');
  1202.                          setarea(start_area,true);
  1203.                          exit;
  1204.                          end ;
  1205.  
  1206.         End;
  1207.                 If aborted Then begin
  1208.                      printxy(19,1,'');
  1209.                      exit;
  1210.                      end;
  1211.             End ;
  1212.             printxy(19,1,'');
  1213.       setarea(start_area,true);
  1214.     End;
  1215.  
  1216.   Procedure addresidentfile(fname:lstr);
  1217.     Var ud:udrec;
  1218.     Two,Times:lstr;
  1219.     Begin
  1220.       getpathname(fname,ud.path,ud.filename);
  1221.       Two:=upstring(ud.path);
  1222.       Times:='VISION';
  1223.       if (match('USERS',ud.filename) ) or (match('USERS.',ud.filename))
  1224.       or (match('VISION.EXE',ud.filename)) or (match('VISION.OVR',ud.filename)) or
  1225.       (match('CONFIG.BBS',ud.filename)) then Begin
  1226.       WriteLn(^F'ViSiON Hack Attempt'^P' - '^S'SysOp Notified'^G^G^G);
  1227.       Exit;
  1228.       End;
  1229.       if  (pos(times,two)>0) then begin
  1230.       writeln ('Sorry Cannot add ViSiON related Dirs ON-LINE!');
  1231.       exit;
  1232.       end;
  1233.       getfsize(ud);
  1234.       If ud.filesize=-1 Then Begin
  1235.         WriteLn('File can''t be opened!');
  1236.         Writestr('Add as [OFFLINE] [y/N] ? :');
  1237.         If yes Then Else exit
  1238.       End;
  1239.       writestr('Point value:');
  1240.       If Length(Input)=0 Then Input:='0';
  1241.       ud.points:=valu(Input);
  1242.       writestr('Send to [CR=None]:');
  1243.       ud.sendto:=input;
  1244.       writestr('File Password [CR=None]:');
  1245.       ud.pass:=input;
  1246.       writestr('Sent by [CR='+^S+unam+^P+']:');
  1247.       If Length(Input)=0 Then Input:=unam;
  1248.       ud.sentby:=Input;
  1249.       ud.when:=now;
  1250.       ud.whenrated:=now;
  1251.       ud.downloaded:=0;
  1252.       writestr('Description: &');
  1253.       ud.descrip:=Input;
  1254.       writestr('Special request only? *');
  1255.       ud.specialfile:=yes;
  1256.       ud.newfile:=False;
  1257.       inc(gnuf);
  1258.       addfile(ud);
  1259.       writelog(16,8,fname)
  1260.     End;
  1261.  
  1262.   Procedure sysopadd;
  1263.     Var fn:lstr;
  1264.         path,name:lstr;
  1265.     Begin
  1266.       If ulvl<configset.sysopleve Then Begin
  1267.         WriteLn
  1268.         ('Only sysops can add files online!');
  1269.         exit
  1270.       End;
  1271.       writehdr('Add File');
  1272.       writestr('Name+path of file ['+^S+area.xmodemdir+^P+']:');
  1273.       getpathname(Input,path,name);
  1274.       if path = '' then
  1275.         fn := area.xmodemdir + name
  1276.       else
  1277.         fn := path + name ;
  1278.  
  1279.       If exist(fn) Then Begin
  1280.         writestr('Confirm: '+^S+fn+^P+' [y/N]:');
  1281.         If yes Then addresidentfile(fn)
  1282.         End
  1283.       Else Begin
  1284.         WriteLn('Disk File can''t be opened!');
  1285.         Writestr('Still Add File [y/N] ? :');
  1286.         If yes Then addresidentfile(fn);
  1287.         End
  1288.     End;
  1289.  
  1290.     Procedure addmultiplefiles;
  1291.     label melkor_sux;
  1292.     Var spath,pathpart:lstr;
  1293.         tarshit:boolean;
  1294.         dummy:sstr;
  1295.         f:File;
  1296.         ffinfo:searchrec;
  1297.         visrad:boolean;
  1298.         n:integer;
  1299.         farry:array [0..600] of sstr;   { Array for Files }
  1300.     Begin
  1301.       If ulvl<configset.sysopleve Then Begin
  1302.         WriteLn('Only True SYSOPS can add files!');
  1303.         exit
  1304.       End;
  1305.       if numuds < 601 then begin
  1306.         WriteStr(^R'Do you wish to skip files '^O'already '^R'online? *');
  1307.         visrad:=Yes;
  1308.         if visrad then begin
  1309.           writeln (^M'Reading in file Names...');
  1310.           reset (udfile);
  1311.           for n:=0 to (numuds - 1) do begin
  1312.             seek (udfile,n);
  1313.             read (udfile,ud);
  1314.             farry[n]:=ud.filename;
  1315.           end;
  1316.         end;
  1317.       end else visrad:=false;
  1318.       writehdr('Add Multiple Files By Wildcard');
  1319.       writestr('Search path/wildcard:');
  1320.       If Length(Input)=0 Then exit;
  1321.       spath:=Input;
  1322.       If spath[Length(spath)]='\' Then dec(spath[0]);
  1323.       Assign(f,spath+'\con');
  1324.       Reset(f);
  1325.       If IOResult=0 Then Begin
  1326.         Close(f);
  1327.         spath:=spath+'\*.*'
  1328.       End;
  1329.       getpathname(spath,pathpart,dummy);
  1330.       findfirst(spath,$17,ffinfo);
  1331.       If doserror<>0
  1332.       Then WriteLn('No files found!')
  1333.       Else
  1334.         While doserror=0 Do Begin
  1335.           if visrad then Begin
  1336.             for n:=0 to (numuds - 1) do
  1337.              if match(ffinfo.name,farry[n]) then goto melkor_sux;
  1338.           End;
  1339.           displayfile(ffinfo);
  1340.           writestr('Add file [Y/n/x]? *');
  1341.           tarshit:=yes;
  1342.           if input='' then tarshit:=true;
  1343.           If tarshit
  1344.           Then addresidentfile(getfname(pathpart,ffinfo.name))
  1345.           Else If (Length(Input)>0) And (UpCase(Input[1])='X')
  1346.             Then exit;
  1347.           writeln;
  1348.           melkor_sux:
  1349.           findnext(ffinfo)
  1350.         End
  1351.     End;
  1352.  
  1353.   
  1354. Procedure changef;
  1355.     Var n,q:Integer;
  1356.       ud:udrec;
  1357.  
  1358.     Procedure showudrec(Var ud:udrec);
  1359.       Begin
  1360.       with ud do begin
  1361.       clearscr;
  1362.            WriteLn(^M^J'[Filename   ]: '^S,upstring(ud.filename),
  1363.           ^M^J'[subdir Path]: '^S,ud.path,
  1364.           ^M^J'[Bytes long ]: '^S,ud.filesize,
  1365.           ^M^J'[point Value]: '^S,ud.points,
  1366.           ^M^J'[Description]: '^S,ud.descrip,
  1367.           ^M^J'[times dload]: '^S,ud.downloaded,
  1368.           ^M^J'[New rating ]: '^S,yesno(ud.newfile),
  1369.           ^M^J'[Password   ]: '^S,ud.pass,
  1370.           ^M^J'[Sending to ]: '^S,sendto,
  1371.           ^M^J'[Special ask]: '^S,yesno(ud.specialfile),
  1372.           ^M^J'[Uploaded by]: '^S,sentby,
  1373.           ^M^J'[date recvd ]: '^S,datestr(when),
  1374.           ^M^J'[time recvd ]: '^S,timestr(when),^M^J);
  1375.       End end;
  1376.  
  1377.     Begin
  1378.       n:=getfilenum('Change');
  1379.       If n=0 Then exit;
  1380.       seekudfile(n);
  1381.       Read(udfile,ud);
  1382.       writelog(16,4,ud.filename);
  1383.       showudrec(ud);
  1384.       Repeat
  1385.         q:=menu('File change','FCHANGE','QUDSNFPVBTA');
  1386.         Case q Of
  1387.           10:begin
  1388.              getstring('Send to [N=No One]',ud.sendto);
  1389.              if match(ud.sendto,'N') then ud.sendto:='';
  1390.              end;
  1391.           11:begin
  1392.              getstring('Password [N=None]',ud.pass);
  1393.              if match(ud.pass,'N') then ud.pass:='';
  1394.              end;
  1395.           2:getstring('uploader',ud.sentby);
  1396.           3:Begin
  1397.               nochain:=True;
  1398.               getstring('description',ud.descrip)
  1399.             End;
  1400.           4:getboo('special request only',ud.specialfile);
  1401.           5:getboo('new file (unrated)',ud.newfile);
  1402.           6:if Ulvl>=configset.sysopleve then getstring('filename',ud.filename);
  1403.           7:if Ulvl>=configset.sysopleve then getstring('path',ud.path);
  1404.           8:getint('point value',ud.points);
  1405.           9:Begin
  1406.               Writestr('Change File to [OFFLINE] (y/N)? :');
  1407.               If yes Then Begin
  1408.                 ud.filesize:=-1;
  1409.                 end
  1410.               else
  1411.                 getfsize(ud);
  1412.                 If ud.filesize=-1 Then writestr('Notice! This file is [OFFLINE]');
  1413.             End;
  1414.         End
  1415.       Until (q=1);
  1416.       seekudfile(n);
  1417.       Write(udfile,ud)
  1418.     End;
  1419. Procedure deletef;
  1420.     Var n,cnt:Integer;
  1421.       fn:lstr;
  1422.       ud:udrec;
  1423.       f:File;
  1424.     Begin
  1425.       n:=getfilenum('delete');
  1426.       If n=0 Then exit;
  1427.       seekudfile(n);
  1428.       Read(udfile,ud);
  1429.       fn:=getfname(ud.path,ud.filename);
  1430.       writelog(16,7,fn);
  1431.       writestr(^P+'('+^V+ud.descrip+^P+')'+^M+^P+'Confirm: File '+^S+fn+^P+' ? *');
  1432.       If Not yes Then exit;
  1433.       removefile(n,true);
  1434.       writestr('Erase disk file '+^S+fn+^P+'? *');
  1435.       If Not yes Then exit;
  1436.       Assign(f,fn);
  1437.       Erase(f)
  1438.     End;
  1439.  
  1440.   Procedure killarea;
  1441.     Var a:arearec;
  1442.       cnt,n:Integer;
  1443.       oldname,newname:sstr;
  1444.     Begin
  1445.       writestr('Delete area #'+^S+strr(curarea)+^P+' ('+^V+area.name+^W+')? *');
  1446.       If Not yes Then exit;
  1447.       writelog(16,2,'');
  1448.       Close(udfile);
  1449.       oldname:='Area'+strr(curarea);
  1450.       If CurrentConference<>1 then OldName:=OldName+'.'+Strr(CurrentConference);
  1451.       Assign(udfile,ConfigSet.ForumDi+oldname);
  1452.       Erase(udfile);
  1453.       For cnt:=curarea To numareas-1 Do Begin
  1454.         newname:=oldname;
  1455.         oldname:='Area'+strr(cnt+1);
  1456.         if CurrentConference<>1 then OldName:=OldName+'.'+Strr(CurrentConference);
  1457.         Assign(udfile,ConfigSet.ForumDi+oldname);
  1458.         Rename(udfile,newname);
  1459.         n:=IOResult;
  1460.         seekafile(cnt+1);
  1461.         Read(afile,a);
  1462.         seekafile(cnt);
  1463.         Write(afile,a)
  1464.       End;
  1465.       seekafile(numareas);
  1466.       Truncate(afile);
  1467.       setarea(1,true)
  1468.     End;
  1469.  
  1470.     Procedure sortarea;
  1471.         Var Mark:Integer;
  1472.  
  1473. procedure shellsort(Left,Right:integer);
  1474. label
  1475.    Again;
  1476. var
  1477.    Pivot:integer;
  1478.    P,Q:integer;
  1479.    tp1,tp2,tp3,tp4:udrec;
  1480.  
  1481.    begin
  1482.       P:=Left;
  1483.       Q:=Right;
  1484.       Pivot:=(Left+Right) div 2;
  1485.       seek(udfile,pivot);
  1486.       read(udfile,tp1);
  1487.       while P<=Q do
  1488.       begin
  1489.        seek(udfile,p);
  1490.        read(udfile,tp2);
  1491.        while (upstring(tp2.filename)<upstring(tp1.filename)) do begin
  1492.              inc(p);
  1493.                          seek(udfile,p);
  1494.              read(udfile,tp2);
  1495.        end;
  1496.          seek(udfile,q);
  1497.          read(udfile,tp3);
  1498.          while (upstring(tp1.filename)<upstring(tp3.filename)) do begin
  1499.                dec(Q);
  1500.                seek(udfile,q);
  1501.                read(udfile,tp3);
  1502.          end;
  1503.          if P>Q then goto Again;
  1504.          tp4:=tp3;
  1505.          tp3:=tp2;
  1506.          tp2:=tp4;
  1507.          seek(udfile,p);
  1508.          write(udfile,tp2);
  1509.          seek(udfile,q);
  1510.          write(udfile,tp3);
  1511.          inc(P);
  1512.          dec(Q);
  1513.             end;
  1514.  
  1515.       Again:
  1516.       if Left<Q  then shellsort(left,Q);
  1517.       if P<Right then shellsort(P,Right);
  1518. end;
  1519.  
  1520.         Begin
  1521.       writehdr('Sort Area');
  1522.       writestr('Confirm [y/N]:');
  1523.       If Not yes Then exit;
  1524.       writelog(16,6,'');
  1525.       Mark:=numuds-1;
  1526.         If Mark<>0 Then Begin
  1527.           writeln(^M^S'ViSiON Super Speedy Sort (tm) in progress...');
  1528.           shellsort(0,mark);
  1529.           writeln(^M^S'('^P,mark,^S') file''s sorted!');
  1530.           End;
  1531.     End;
  1532.  
  1533.     Procedure movefile;
  1534.     Var an,fn,oldn:Integer;
  1535.         newfilesam,sambam,filesam,wangbang:anystr;
  1536.         darn:File;
  1537.       ud:udrec;
  1538.     Begin
  1539.       oldn:=curarea;
  1540.       fn:=getfilenum('move');
  1541.       If fn=0 Then exit;
  1542.        Input:='';
  1543.       an:=getareanum;
  1544.      If an=0 Then exit;
  1545.       WriteLn('Moving...');
  1546.      seekudfile(fn);
  1547.      Read(udfile,ud);
  1548.       writelog(16,5,ud.filename);
  1549.          removefile(fn,false);
  1550.      filesam:=GetFName(ud.Path,ud.FileName);
  1551.      sambam:=ud.Path;
  1552.      setarea(an,true);
  1553.      Write('Current Free Space: ');
  1554.      writefreespace(area.xmodemdir);
  1555.      writestr('Physically move the file to correct area? *') ;
  1556.      If (sambam<>area.xmodemdir) Then If yes Then Begin
  1557.        ud.Path:=area.xmodemdir;
  1558.        newfilesam:=GetFName(ud.Path,ud.FileName);
  1559.        exec(getenv('comspec'),'/c Copy '+filesam+' '+newfilesam+' > nul' );
  1560.        wangbang:=filesam;
  1561.        Assign(darn,wangbang);
  1562.        If exist(newfilesam) Then Erase(darn) Else Begin
  1563.          ud.Path:=sambam;
  1564.          WriteLn('Uh oh... Bad error!');
  1565.        End;
  1566.      End;
  1567.       addfile(ud);
  1568.       setarea(oldn,true);
  1569.       WriteLn(^B'Done.')
  1570.     End;
  1571.  
  1572.  
  1573.   Procedure multmovefile;
  1574.     Var an,sfn,efn,fn,oldn:Integer;
  1575.         newfilesam,sambam,filesam,wangbang:anystr;
  1576.         darn:File;
  1577.       ud:udrec;
  1578.     Begin
  1579.       oldn:=curarea;
  1580.       fn:=getfilenum('start move');
  1581.       if fn=0 then exit;
  1582.       input:='';
  1583.       efn:=getfilenum('end move');
  1584.       If efn=0 Then exit;
  1585.        Input:='';
  1586.       an:=getareanum;
  1587.      If an=0 Then exit;
  1588.      for sfn:=fn to efn do begin
  1589.      seekudfile(fn);
  1590.      Read(udfile,ud);
  1591.       writeln('Moving '+ud.filename+'...');
  1592.       writelog(16,5,ud.filename);
  1593.      removefile(fn,false);
  1594.      filesam:=GetFName(ud.Path,ud.FileName);
  1595.      sambam:=ud.Path;
  1596.      setarea(an,true);
  1597.      write('Current Free Space: '); writefreespace(area.xmodemdir);
  1598.      writestr(^M'Physically move '+ud.filename+' to correct area? *') ;
  1599.      If (sambam<>area.xmodemdir) Then If yes Then Begin
  1600.        ud.Path:=area.xmodemdir;
  1601.        newfilesam:=GetFName(ud.Path,ud.FileName);
  1602.        exec(getenv('comspec'),'/c Copy '+filesam+' '+newfilesam+' > nul' );
  1603.        wangbang:=filesam;
  1604.        Assign(darn,wangbang);
  1605.        If exist(newfilesam) Then Erase(darn) Else Begin
  1606.          ud.Path:=sambam;
  1607.          WriteLn('Uh oh... Bad error!');
  1608.        End;
  1609.      End;
  1610.       addfile(ud);
  1611.       setarea(oldn,true);
  1612.       writeln(^M'File moved.');
  1613.      end;
  1614.       WriteLn(^B'Done.')
  1615.     End;
  1616.  
  1617.      Procedure BatchMove;
  1618.         Var an,fn,oldn,cnt:Integer;
  1619.                 newfilesam,sambam,filesam,wangbang:anystr;
  1620.                 darn:File;
  1621.             ud:udrec;
  1622.         Begin
  1623.         if filesinbatch=0 then exit;
  1624.         an:=getareanum;
  1625.         if an=0 then exit;
  1626.         oldn:=curarea;
  1627.         for cnt:=1 to filesinbatch do
  1628.         begin
  1629.             setarea(batchdown[cnt].area,false);
  1630.              input:='B'+BatchDown[Cnt].FileName;
  1631.              fn:=getfilenum('move');
  1632.              if fn<>0 then
  1633.              begin
  1634.             WriteLn('Moving...');
  1635.          seekudfile(fn);
  1636.          Read(udfile,ud);
  1637.             writelog(16,5,ud.filename);
  1638.          removefile(fn,false);
  1639.          filesam:=GetFName(ud.Path,ud.FileName);
  1640.          sambam:=ud.Path;
  1641.          setarea(an,False);
  1642.          Write('Current Free Space: ');
  1643.          writefreespace(area.xmodemdir);
  1644.          writestr('Physically move the file to correct area? *') ;
  1645.          If (sambam<>area.xmodemdir) Then If yes Then Begin
  1646.              ud.Path:=area.xmodemdir;
  1647.              newfilesam:=GetFName(ud.Path,ud.FileName);
  1648.        exec(getenv('comspec'),'/c Copy '+filesam+' '+newfilesam+' > nul' );
  1649.        wangbang:=filesam;
  1650.        Assign(darn,wangbang);
  1651.        If exist(newfilesam) Then Erase(darn) Else Begin
  1652.          ud.Path:=sambam;
  1653.          WriteLn('Uh oh... Bad error!');
  1654.        End;
  1655.      End;
  1656.       addfile(ud);
  1657.       setarea(oldn,true);
  1658.             WriteLn(^B'Done.')
  1659.             end else
  1660.                 writeLn(^S'File '+BatchDown[Cnt].FileName+' not found!');
  1661.             end;
  1662.             clear_batchdown;
  1663.         End;
  1664.  
  1665.      Procedure BatchDel;
  1666.      Var Oldn,Fn,Cnt:Integer;
  1667.              ud:udrec;
  1668.              F:File;
  1669.      Begin
  1670.          OldN:=CurArea;
  1671.          If FilesInBatch=0 then Exit;
  1672.          For Cnt:=1 to FilesInBatch Do
  1673.              Begin
  1674.                 WriteStr('Delete File '+BatchDown[Cnt].FileName+'? *');
  1675.                 If yes then Begin
  1676.                  Input:='B'+BatchDown[Cnt].Filename;
  1677.                  SetArea(BatchDown[Cnt].Area,false);
  1678.                  Fn:=GetFileNum('BatchDel');
  1679.                  If Fn<>0 then Begin
  1680.                  SeekUdfile(Fn);
  1681.                  Read(Udfile,Ud);
  1682.                  If Exist(GetFname(Ud.Path,Ud.FileName)) then
  1683.                      Begin
  1684.                          WriteStr(^M'Physically '+GetFname(Ud.Path,Ud.FileName)+'? *');
  1685.                          If Yes then
  1686.                              Begin
  1687.                                  Assign(F,GetFname(Ud.Path,Ud.FileName));
  1688.                                  Erase(F);
  1689.                              End;
  1690.                          End;
  1691.                          RemoveFile(Fn,true);
  1692.                          WriteLog(16,7,Ud.FileName);
  1693.                  End;
  1694.         End;
  1695.             End;
  1696.             Clear_BatchDown;
  1697.          End;
  1698.  
  1699.     Procedure renamefile;
  1700.     Var fn:Integer;
  1701.       ud:udrec;
  1702.       f:File;
  1703.     Begin
  1704.       fn:=getfilenum('rename');
  1705.       If fn=0 Then exit;
  1706.       seekudfile(fn);
  1707.       Read(udfile,ud);
  1708.       writestr('Enter new filename:');
  1709.       If match(Input,ud.filename)
  1710.       Then
  1711.         ud.filename:=Input
  1712.       Else If Length(Input)>0
  1713.         Then If validfname(Input)
  1714.           Then If exist(getfname(ud.path,Input))
  1715.             Then
  1716.               WriteLn('Name already in use!')
  1717.             Else
  1718.               Begin
  1719.                 Assign(f,getfname(ud.path,ud.filename));
  1720.                 Rename(f,getfname(ud.path,Input));
  1721.                 If IOResult=0 Then Begin
  1722.                   ud.filename:=Input;
  1723.                   WriteLn(^B^M'File renamed.')
  1724.                 End Else WriteLn(^B^M'Unable to rename file!')
  1725.               End
  1726.           Else WriteLn('Invalid filename!');
  1727.       seekudfile(fn);
  1728.       Write(udfile,ud)
  1729.     End;
  1730.  
  1731.   Procedure listxmodem;
  1732.     Var cnt:Integer;
  1733.       u:userrec;
  1734.     Begin
  1735.       Seek(ufile,1);
  1736.       WriteLn('Name                          Lvl Pts'^M);
  1737.       For cnt:=1 To numusers Do Begin
  1738.         Read(ufile,u);
  1739.         If u.handle<>'' Then
  1740.           If u.udlevel>0 Then Begin
  1741.             tab(u.handle,30);
  1742.             tab(strr(u.udlevel),4);
  1743.             WriteLn(u.udpoints);
  1744.             If break Then exit
  1745.           End
  1746.       End
  1747.     End;
  1748.  
  1749.   Procedure reorderareas;
  1750.     Var numa,cura,newa:Integer;
  1751.       a1,a2:arearec;
  1752.       f1,f2:File;
  1753.       fn1,fn2:sstr;
  1754.     Label exit;
  1755.     Begin
  1756.       writelog(16,9,'');
  1757.       writehdr('Re-order Areas');
  1758.       numa:=FileSize(afile);
  1759.       WriteLn('Number of areas: ',numa);
  1760.       For cura:=0 To numa-2 Do Begin
  1761.         Repeat
  1762.           writestr('New area #'+^V+strr(cura+1)+^P+' [?/List, CR to quit]:');
  1763.           If Length(Input)=0 Then GoTo exit;
  1764.           If Input='?'
  1765.           Then
  1766.             Begin
  1767.               listareas;
  1768.               newa:=-1
  1769.             End
  1770.           Else
  1771.             Begin
  1772.               newa:=valu(Input)-1;
  1773.               If (newa<0) Or (newa>numa) Then Begin
  1774.                 WriteLn('Not found!  Please re-enter...');
  1775.                 newa:=-1
  1776.               End
  1777.             End
  1778.         Until (newa>=0);
  1779.         if newa=cura then WriteLn(^M^S'Same file area as currently is, skipping this area..'^M)
  1780.         else Begin
  1781.         Seek(afile,cura);
  1782.         Read(afile,a1);
  1783.         Seek(afile,newa);
  1784.         Read(afile,a2);
  1785.         Seek(afile,cura);
  1786.         Write(afile,a2);
  1787.         Seek(afile,newa);
  1788.         Write(afile,a1);
  1789.         fn1:='Area';
  1790.         fn2:=fn1+strr(newa+1);
  1791.         fn1:=fn1+strr(cura+1);
  1792.         if CurrentConference<>1 then Begin
  1793.         Fn2:=Fn2+'.'+Strr(CurrentConference);
  1794.         Fn1:=Fn1+'.'+Strr(CurrentConference);
  1795.         End;
  1796.         Assign(f1,ConfigSet.ForumDi+fn1);
  1797.         Assign(f2,ConfigSet.ForumDi+fn2);
  1798.         Rename(f1,'Temp$$$$');
  1799.         Rename(f2,fn1);
  1800.         Rename(f1,fn2)
  1801.         End;
  1802.       End;
  1803. exit:
  1804.       setarea(1,true)
  1805.     End;
  1806.  
  1807.   Procedure newfiles;
  1808.     Var a,fn,un:Integer;
  1809.       ud:udrec;
  1810.       u:userrec;
  1811.       krad:lstr;
  1812.       flag,aborted:Boolean;
  1813.  
  1814.     Procedure writeudrec;
  1815.       Begin
  1816.         seekudfile(fn);
  1817.         Write(udfile,ud)
  1818.       End;
  1819.  
  1820.     Procedure ratefile(p:Integer);
  1821.       Begin
  1822.         ud.points:=p;
  1823.         ud.newfile:=False;
  1824.         ud.whenrated:=now;
  1825.         writeudrec;
  1826.         p:=p*configset.uploadfacto;
  1827.         If p>0 Then Begin
  1828.           Writestr('Actually give user How many pts? ['+^V+strr(p)+^P+'] :');
  1829.           If Input='' Then Else If (valu(Input)>0) Or (Input='0') Then p:=valu(Input);
  1830.           un:=lookupuser(ud.sentby);
  1831.           If un=0
  1832.           Then WriteLn(ud.sentby,' has vanished!')
  1833.           Else Begin
  1834.             WriteLn('Giving ',ud.sentby,' ',p,' points.');
  1835.             If un=unum Then writeurec;
  1836.             Seek(ufile,un);
  1837.             Read(ufile,u);
  1838.             u.udpoints:=u.udpoints+p;
  1839.             Seek(ufile,un);
  1840.             Write(ufile,u);
  1841.             If un=unum Then readurec
  1842.           End
  1843.         End
  1844.       End;
  1845.  
  1846.     Procedure doarea;
  1847.       Var i,advance:Integer;
  1848.         done:Boolean;
  1849.       Begin
  1850.         fn:=1;
  1851.         advance:=0;
  1852.         While fn+advance<=numuds Do Begin
  1853.           fn:=fn+advance;
  1854.           advance:=1;
  1855.           seekudfile(fn);
  1856.           Read(udfile,ud);
  1857.           If ud.newfile Then Begin
  1858.             flag:=False;
  1859.             done:=False;
  1860.             Repeat clearscr;
  1861.               printxy(1,1,'');
  1862.               WriteLn(^B^M'[Filename   ]:',upstring(ud.filename),
  1863.               ^M'[SubDir Path]:',ud.path,
  1864.               ^M'[Uploaded by]:',ud.sentby,
  1865.               ^M'[File Size  ]:',ud.filesize,
  1866.               ^M'[Description]:',ud.descrip);
  1867.               i:=menu('Newscan','NEWSCAN','Q#_CEDRM0V');
  1868.               Input:=' '+strr(fn);
  1869.               If i<0
  1870.               Then
  1871.                 Begin
  1872.                   ratefile(-i);
  1873.                   done:=True
  1874.                 End
  1875.               Else
  1876.                 Case i Of
  1877.                   1:Begin
  1878.                       aborted:=True;
  1879.                       exit
  1880.                     End;
  1881.                   3:done:=True;
  1882.                   4:Begin
  1883.                       writestr('Enter new description:');
  1884.                       If Length(Input)>0 Then ud.descrip:=Input;
  1885.                       writeudrec
  1886.                     End;
  1887.                   5:Begin
  1888.                       renamefile;
  1889.                       advance:=0
  1890.                     End;
  1891.                   6:Begin
  1892.                       deletef;
  1893.                       advance:=0
  1894.                     End;
  1895.                   7:listarchive;
  1896.                   8:Begin
  1897.                       movefile;
  1898.                       advance:=0
  1899.                     End;
  1900.                   9:Begin
  1901.                       ratefile(0);
  1902.                       done:=True
  1903.                     End
  1904.                 End
  1905.             Until done Or (advance=0)
  1906.           End
  1907.         End
  1908.       End;
  1909.  
  1910.     Begin
  1911.       flag:=True;
  1912.       writelog(16,1,'');
  1913.       If issysop Then Begin
  1914.         writestr('Newscan all areas? *');
  1915.         If yes Then Begin
  1916.           For a:=1 To numareas Do Begin
  1917.             setarea(a,true);
  1918.             aborted:=False;
  1919.             doarea;
  1920.             If aborted Then exit
  1921.           End
  1922.         End Else doarea
  1923.       End Else doarea;
  1924.       If flag Then WriteLn(^B'No new files.')
  1925.     End;
  1926.  
  1927.   Procedure sysopcommands;
  1928.     Var i:Integer;
  1929.     Begin
  1930.       If Not sponsoron Then Begin
  1931.         reqlevel(configset.sysopleve);
  1932.         exit
  1933.       End;
  1934.       writelog(15,3,area.name);
  1935.       Repeat
  1936.       i:=menu('File sponsor','FSYSOP','A@CDF@G@KRNSMLO@QEWX+Z*@');
  1937.         Case i Of
  1938.           1:sysopadd;
  1939.           2:changef;
  1940.           3:deletef;
  1941.           4:directory;
  1942.           6:killarea;
  1943.           7:modarea;
  1944.           8:newfiles;
  1945.           9:sortarea;
  1946.           10:movefile;
  1947.           11:listxmodem;
  1948.           12:reorderareas;
  1949.           14:renamefile;
  1950.           15:addmultiplefiles;
  1951.       17:WriteLn(^M^S'Sorry, that function is temporarily offline!');
  1952.       19:getarea;
  1953.       16:multmovefile;
  1954.       18:Begin
  1955.       ClearScr;
  1956.       WriteHdr('Batch Commands');
  1957.       WriteLn(^S'[1] '^R'Move Batch Que');
  1958.       WriteLn(^S'[2] '^R'Delete files in Batch Que');
  1959.       WriteStr(^M^P'Which:');
  1960.       Case Valu(Input) of
  1961.       1:BatchMove;
  1962.       2:BatchDel;
  1963.          End;
  1964.          End;
  1965.          End
  1966.       Until hungupon Or (i=13)
  1967.     End;
  1968.  
  1969.   Procedure batch_menu;
  1970.     Var i:Integer;
  1971.     Begin
  1972.       Writehdr('Batch Transfer Menu');
  1973.       Repeat
  1974.         i:=menu('Batch Xfer','FBATCH','CLDUQAX');
  1975.         Case i Of
  1976.           1:begin
  1977.              clear_Batchdown;
  1978.              writeln(^M'Batch Que and Bi-Modem Que Cleared!');
  1979.              end;
  1980.           2:listbatch;
  1981.           3:do_batch_download;
  1982.       4:if area.uploadhere=true then Batch_Upload else
  1983.       WriteLn(^M^S'You may not upload to this area!'^M);
  1984.           6:bimodemupload;
  1985.           7:DOBIXFER;
  1986.         End
  1987.       Until hungupon Or (i=5)
  1988.     End;
  1989.  
  1990.   Var i:Integer;
  1991.     a:arearec;
  1992.     ms:Boolean;
  1993.     taxz:boolean;
  1994.     tzz:Mstr;
  1995.  
  1996.   Label ok,exit;
  1997.   Begin
  1998.   killbimodem;
  1999.   clear_batchdown;
  2000.     cursection:=udsysop;
  2001.     ms:=False;
  2002.       Write(^R);
  2003.     Input:='';
  2004.     Tzz:='areadir';
  2005.     if CurrentConference<>1 then Tzz:=Tzz+'.'+Strr(CurrentConference);
  2006.     Assign(afile,ConfigSet.ForumDi+tzz);
  2007.     If exist(ConfigSet.ForumDi+tzz)
  2008.     Then
  2009.       Begin
  2010.         Reset(afile);
  2011.         If FileSize(afile)>0 Then GoTo ok
  2012.       End
  2013.     Else Rewrite(afile);
  2014.     WriteLn('No File areas Exist!!');
  2015.     area.xmodemdir:=configset.forumdi+'XMODEM\';
  2016.     If issysop
  2017.     Then If makearea
  2018.       Then GoTo ok;
  2019.     GoTo exit;
  2020.     ok:
  2021.     seekafile(1);
  2022.     Read(afile,a);
  2023.     If Not(Allowed_in_Area(a)) Then Begin
  2024.       WriteLn(^S'You do not have access to the file section!');
  2025.       GoTo exit
  2026.     End; if not pcratio then begin
  2027.      printxy(21,0,'');
  2028.      writeln('Your Post/Call Ratio is out of line. Go to the message bases and POST');
  2029.      writeln('some messages in order to correct this!');
  2030.      goto exit;
  2031.      end;
  2032.     UserCheck;
  2033.     yourudstatus;
  2034.      if exist(configset.textfiledi+'Filenews.BBS') then begin
  2035.      buflen:=0;
  2036.      printfile(configset.textfiledi+'Filenews.BBS');
  2037.      end;
  2038.      load_protos;
  2039.      setarea(1,true);
  2040.      if configset.shownewprompts then begin
  2041.      WriteStr(^R'Invoke a scan for new files? '^O'['^A'N'^O']'^P':*');
  2042.      If Yes then NewScanAll;
  2043.      end;
  2044.       Repeat
  2045.         If withintime(configset.xmodemclosetim,configset.xmodemopentim) or (timetillnet<30) Then
  2046.           If Not issysop Then Begin
  2047.             if timetillnet<30 then tzz:=configset.netenc else tzz:=configset.xmodemopentim;
  2048.             writestr(^M^M'File section is closed at this time!');
  2049.             WriteLn('The time is now   : '^S,timestr(now));
  2050.             WriteLn('File area opens at: '^S,tzz);
  2051.             GoTo exit
  2052.           End Else If Not ms Then Begin
  2053.             WriteLn('The File area is closed until ',configset.xmodemopentim);
  2054.             ms:=True
  2055.           End;
  2056.         If  ((vt52 in urec.config) or (ansigraphics In urec.config)) Then Begin
  2057. (*          If WhereY>21 Then Begin printxy(24,1,'');WriteLn(^B^M^M);End;
  2058.           printxy(22,1,''); *)
  2059.         WriteLn;
  2060.         Write(^B^S,area.name,^R' ['^S,curarea,^R']') End Else
  2061.           WriteLn(^B^M^M^S,area.name,^R' ['^S,curarea,^R']');
  2062.           i:=menu('File','FILE','UDLFYA!SQ%NVHRXWT+BG*IK');
  2063.         If hungupon Then GoTo exit;
  2064.         Case i Of
  2065.           1:upload;
  2066.           2:download(0,'',0);
  2067.           3,4:listfiles(False);
  2068.       5:yourudstatus;
  2069.       21,6:getarea;
  2070.           8:searchfile;
  2071.           7:;
  2072.           10:sysopcommands;
  2073.           11:newscanall;
  2074.           12:newscan;
  2075.           13:help('Filexfer.hlp');
  2076.           14:listarchive;
  2077.           15:printfile(configset.textfiledi+'Wantlist.bbs');
  2078.           16:listfiles(True);
  2079.           17:typefile;
  2080.           18:add_to_batch(0,'',0);
  2081.           19:batch_menu;
  2082.           20:offtheforum;
  2083.           22:zipfile;
  2084.           23:UserFileListing;
  2085.         End
  2086.  
  2087.       Until hungupon Or (i=9);
  2088. exit:
  2089.     Close(afile);
  2090.     Close(udfile);
  2091.     i:=IOResult;
  2092.   End;
  2093.  
  2094.   begin
  2095.   end.